home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / dev / lang / VgaPoing.lha / VGAHi_Poing.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-25  |  4KB  |  166 lines
  1. {***************************************************************}
  2. { Poing... a small HiSpeed/Turbo Pascal demo of a bouncing 'o'  }
  3. { By Hans Luyten                                                }
  4. {***************************************************************}
  5. { VGA version...                                                }
  6. {***************************************************************}
  7. PROGRAM Poing;
  8.  
  9. Uses  Graph,Crt;
  10.  
  11. VAR
  12.   MaxX  : INTEGER;
  13.   MaxY  : INTEGER;
  14.   MinX  : INTEGER;
  15.   MinY  : INTEGER;
  16.   XStart:  INTEGER;
  17.   YStart:  INTEGER;
  18.  
  19. FUNCTION VGAOpen:BOOLEAN;    
  20. VAR
  21.   Driver  : INTEGER;
  22.   Mode    : INTEGER;
  23.   
  24. BEGIN
  25.   Driver:=Detect;
  26.   InitGraph(Driver,Mode,'');
  27.   SetGraphMode(VGAHi);
  28.   SetRGBPalette(Black   ,0 ,0 ,0 );
  29.   SetRGBPalette(Yellow  ,63,63,0 );
  30.   SetRGBPalette(DarkGray,15,15,15);
  31. END;
  32.  
  33. {***************************************************************}
  34. { DrawBall(X,Y,Wipe);                                           }
  35. { Bal tekenen, indien wipe=TRUE dan wissen !!                   }
  36. {***************************************************************}
  37. PROCEDURE DrawBall(X,Y : INTEGER;Wipe : BOOLEAN);
  38. BEGIN
  39.   IF Wipe THEN
  40.     SetColor(Black)
  41.   ELSE
  42.     SetColor(Yellow);
  43.   Circle(X,Y,5);
  44. END;
  45.       
  46.   
  47. {***************************************************************}
  48. { ReadData(XStart,YStart,XMax,YMax);                            }
  49. { Vraagt kader omvang en start positie...                       }
  50. {***************************************************************}
  51. PROCEDURE ReadData(VAR Xs,Ys : INTEGER;VAR X,Y : INTEGER);
  52. BEGIN
  53.   ClrScr;
  54.   GotoXY(5,8);
  55.   Write('PoingPoing... a short Pascal demo.');
  56.   REPEAT
  57.     BEGIN
  58.       GotoXY(5,10);
  59.       Write('Breedte van het kader (maximaal 630): ');
  60.       READLN(X);
  61.     END;
  62.   UNTIL (X>7)AND(X<631);
  63.   REPEAT
  64.     BEGIN
  65.       GotoXY(5,12);
  66.       Write('Hoogte van het kader  (Maximaal 450): ');
  67.       READLN(Y);
  68.     END;
  69.   UNTIL (Y>7)AND(Y<451);
  70.   REPEAT
  71.     BEGIN
  72.       GotoXY(5,14);
  73.       Write('Start positie van X (Maximaal ',X,'): ');
  74.       READLN(Xs);
  75.     END;
  76.   UNTIL (Xs>1)AND(Xs<X);
  77.   REPEAT
  78.     BEGIN
  79.       GotoXY(5,16);
  80.       Write('Start positie van Y (Maximaal ',Y,'): ');
  81.       READLN(Ys);
  82.     END;
  83.   UNTIL (Ys>1)AND(Ys<Y);
  84. END;
  85.  
  86. {***************************************************************}
  87. { DrawBox(X1,Y1,X2,Y2);                                         }
  88. { Tekent een kader van X1,Y1 tot X2,Y2.                         }
  89. {***************************************************************}
  90. PROCEDURE DrawBox(X1,Y1,X2,Y2 : INTEGER);
  91. VAR
  92.   Teller  :  INTEGER;
  93. BEGIN
  94.   SetFillStyle(SolidFill,Black);
  95.   SetColor(DarkGray);
  96.   Bar(X1,Y1,X2,Y2);
  97.   OutTextXY(20,Y2+20,'Stoppen kan door een toets in te drukken');
  98. END;
  99.  
  100. {***************************************************************}
  101. { DoPoing(XStart,YStart,XMax,YMax);                             }
  102. { Stuiter procedure...                                          }
  103. {***************************************************************}
  104. PROCEDURE DoPoing(X,Y,XMax,YMax : INTEGER);
  105. VAR
  106.   c      :  CHAR;
  107.   XMode  :  BOOLEAN;
  108.   YMode  :  BOOLEAN;
  109.   OldX  : INTEGER;
  110.   OldY  :  INTEGER;
  111.   
  112. BEGIN
  113.   IF KeyPressed THEN
  114.     c:=ReadKey;
  115.   XMode:=TRUE;
  116.   YMode:=TRUE;
  117.   OldX:=X;
  118.   OldY:=Y;
  119.   XMax:=PRED(XMax);
  120.   REPEAT
  121.     BEGIN
  122.       DrawBall(X,Y,FALSE);
  123.       OldX:=X;
  124.       OldY:=Y;
  125.       IF X>=XMax THEN
  126.         XMode:=FALSE
  127.       ELSE IF X<=12 THEN
  128.         XMode:=TRUE;
  129.       
  130.       IF XMode THEN
  131.         X:=X+4
  132.       ELSE
  133.         X:=X-4;
  134.               
  135.       IF Y>=YMax THEN
  136.         YMode:=FALSE
  137.       ELSE IF Y<=11 THEN
  138.         YMode:=TRUE;
  139.         
  140.       IF YMode THEN
  141.         Y:=Y+4
  142.       ELSE
  143.         Y:=Y-4;
  144.       
  145.       DrawBall(OldX,OldY,TRUE);
  146.     
  147.     END;
  148.   UNTIL (KeyPressed);
  149. END;
  150.  
  151. {***************************************************************}
  152. { MAIN                                                          }
  153. {***************************************************************}
  154. BEGIN
  155.   MinX:=1;
  156.   MinY:=1;
  157.   ReadData(XStart,YStart,MaxX,MaxY);  
  158.   IF VGAOpen THEN
  159.     BEGIN
  160.       DrawBox(MinX,MinY,MaxX,MaxY);
  161.       DoPoing(XStart,YStart,MaxX-10,MaxY-10);
  162.       CloseGraph;
  163.     END;
  164. END.
  165.   
  166.